home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / toolbar / util.bas < prev   
BASIC Source File  |  1995-05-09  |  6KB  |  146 lines
  1. Option Explicit
  2. Dim WinVersion As Integer, SoundAvailable As Integer
  3. Global VisibleFrame As Frame
  4.  
  5. Global Const TWIPS = 1
  6. Global Const PIXELS = 3
  7. Global Const RES_INFO = 2
  8. Global Const MINIMIZED = 1
  9.  
  10. Type Rect
  11.     Left As Integer
  12.     Top As Integer
  13.     Right As Integer
  14.     Bottom As Integer
  15. End Type
  16.  
  17. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal P$, ByVal S%) As Integer
  18. Declare Function GetSystemDirectory Lib "kernel" (ByVal P$, ByVal S%) As Integer
  19. Declare Function GetWinFlags Lib "kernel" () As Long
  20. Global Const WF_CPU286 = &H2&
  21. Global Const WF_CPU386 = &H4&
  22. Global Const WF_CPU486 = &H8&
  23. Global Const WF_STANDARD = &H10&
  24. Global Const WF_ENHANCED = &H20&
  25. Global Const WF_80x87 = &H400&
  26.  
  27. Declare Function GetVersion Lib "Kernel" () As Long
  28. Declare Function GetSystemMetrics Lib "User" (ByVal n As Integer) As Integer
  29. Global Const SM_MOUSEPRESENT = 19
  30.  
  31. Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC%, ByVal nIndex%) As Integer
  32.  
  33. Declare Function GlobalCompact Lib "kernel" (ByVal flag&) As Long
  34. Declare Function GetFreeSpace Lib "kernel" (ByVal flag%) As Long
  35. Declare Function GetFreeSystemResources Lib "User" (ByVal fuSysResource As Integer) As Integer
  36. Global Const GFSR_SYSTEMRESOURCES = &H0
  37. Global Const GFSR_GDIRESOURCES = &H1
  38. Global Const GFSR_USERRESOURCES = &H2
  39.  
  40. Declare Function sndPlaySound Lib "MMSystem" (lpsound As Any, ByVal flag As Integer) As Integer
  41. Declare Function waveOutGetNumDevs Lib "MMSystem" () As Integer
  42.  
  43. Declare Function TrackPopupMenu Lib "user" (ByVal hMenu%, ByVal wFlags%, ByVal x%, ByVal y%, ByVal r2%, ByVal hWd%, r As Rect) As Integer
  44. Declare Function GetMenu Lib "user" (ByVal hWd%) As Integer
  45. Declare Function GetSubMenu Lib "user" (ByVal hMenu%, ByVal nPos%) As Integer
  46. Declare Function InsertMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As Any) As Integer
  47. Declare Function GetSystemMenu Lib "User" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer
  48. Global Const MF_POPUP = &H10
  49. Global Const MF_BYPOSITION = &H400
  50. Global Const MF_SEPARATOR = &H800
  51.  
  52. Declare Function GetDeskTopWindow Lib "User" () As Integer
  53. Declare Function GetDC Lib "User" (ByVal hWnd%) As Integer
  54. Declare Sub ReleaseDC Lib "User" (ByVal hWnd%, ByVal hDC%)
  55. Declare Function BitBlt Lib "GDI" (ByVal destDC%, ByVal x%, ByVal y%, ByVal w%, ByVal h%, ByVal srchDC%, ByVal srcX%, ByVal srcY%, ByVal rop&) As Integer
  56. Global Const SRCCOPY = &HCC0020
  57. Global Const SRCERASE = &H440328
  58. Global Const SRCINVERT = &H660046
  59. Global Const SRCAND = &H8800C6
  60.  
  61. Declare Sub SetWindowPos Lib "User" (ByVal h1%, ByVal h2%, ByVal x%, ByVal y%, ByVal cx%, ByVal cy%, ByVal f%)
  62. Global Const HWND_TOPMOST = -1
  63. Global Const HWND_NOTOPMOST = -2
  64. Global Const SWP_NOACTIVATE = &H10
  65. Global Const SWP_SHOWWINDOW = &H40
  66.  
  67. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  68. Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
  69.  
  70. Sub AboutApp ()
  71. Dim x As String
  72. x = "Tool Tips Framework"
  73. app.Title = x
  74. End Sub
  75.  
  76. Sub centerform (x As Form)
  77.   
  78.     Screen.MousePointer = 11
  79.     x.Top = (Screen.Height * .85) / 2 - x.Height / 2
  80.     x.Left = Screen.Width / 2 - x.Width / 2
  81.     Screen.MousePointer = 0
  82.  
  83. End Sub
  84.  
  85. Function DeviceColors (hDC As Integer) As Long
  86. Const PLANES = 14
  87. Const BITSPIXEL = 12
  88.     DeviceColors = GetDeviceCaps(hDC, PLANES) * 2 ^ GetDeviceCaps(hDC, BITSPIXEL)
  89. End Function
  90.  
  91. Function DosVersion ()
  92. Dim Ver As Long, DosVer As Long
  93.     Ver = GetVersion()
  94.     DosVer = Ver \ &H10000
  95.     DosVersion = Format((DosVer \ 256) + ((DosVer Mod 256) / 100), "Fixed")
  96. End Function
  97.  
  98. Function GetSysini (section, key)
  99. Dim retVal As String, AppName As String, worked As Integer
  100.     retVal = String$(255, 0)
  101.     worked = GetPrivateProfileString(section, key, "", retVal, Len(retVal), "System.ini")
  102.     If worked = 0 Then
  103.     GetSysini = "unknown"
  104.     Else
  105.     GetSysini = Left(retVal, worked)
  106.     End If
  107. End Function
  108.  
  109. Function GetWinIni (section, key)
  110. Dim retVal As String, AppName As String, worked As Integer
  111.     retVal = String$(255, 0)
  112.     worked = GetProfileString(section, key, "", retVal, Len(retVal))
  113.     If worked = 0 Then
  114.     GetWinIni = "unknown"
  115.     Else
  116.     GetWinIni = Left(retVal, worked)
  117.     End If
  118. End Function
  119.  
  120. Sub Main ()
  121. MsgBox " If you get a GPF, restart Windows and remove the FrmAbout.Frm from the project. It is the inconsistant API calls that cause it so take them out."
  122. MsgBox " The rest of the code is still a very good example of using VB to implement " & """ToolTips"""
  123. FrmMain.Show
  124. End Sub
  125.  
  126. Function SystemDirectory () As String
  127. Dim WinPath As String
  128.     WinPath = String(145, Chr(0))
  129.     SystemDirectory = Left(WinPath, GetSystemDirectory(WinPath, Len(WinPath)))
  130.  
  131. End Function
  132.  
  133. Function WindowsDirectory () As String
  134. Dim WinPath As String
  135.     WinPath = String(145, Chr(0))
  136.     WindowsDirectory = Left(WinPath, GetWindowsDirectory(WinPath, Len(WinPath)))
  137. End Function
  138.  
  139. Function WindowsVersion ()
  140. Dim Ver As Long, WinVer As Long
  141.     Ver = GetVersion()
  142.     WinVer = Ver And &HFFFF&
  143.     WindowsVersion = Format((WinVer Mod 256) + ((WinVer \ 256) / 100), "Fixed")
  144. End Function
  145.  
  146.